home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol037 / bmenu.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  4.9 KB  |  121 lines
  1. 10 '
  2. 20 ' DO NOT RENUM OR RENAME OR COMPILE THIS PROGRAM.
  3. 30 '
  4. 40 ' BASIC MENU PROGRAM. VERSION 1.0
  5. 50 ' A MAXIMUM OF 112 BASIC FILES WILL BE HANDLED BY THIS PROGRAM.
  6. 60 ' SEE BMENU.DOC FOR MORE INFORMATION. BOB STEPHENS  SAN JOSE 12/1/82
  7. 70 DEFINT A-Z:DIM ARRAY$(113)
  8. 80 DEF SEG=0:MN=PEEK(&H410) AND &H30:IF MN=&H30 THEN MN=1 ELSE MN=0
  9. 90 SCREEN 0:IF MN=0 THEN COLOR 14,1,4 ELSE COLOR 7,0
  10. 110 KEY OFF :KEY 10,"RUN"+CHR$(34)+"BMENU"+CHR$(13)
  11. 120 KEY 1,"UPDATE":KEY 2,"HELP":KEY 3,"BASIC":KEY 4,"DOS":KEY 5,"DATE"
  12. 130 KEY(1) ON:KEY(2) ON:KEY(3) ON:KEY(4) ON:KEY(5) ON
  13. 140 ON KEY(1) GOSUB 1210:ON KEY(2) GOSUB 1670:ON KEY(3) GOSUB 1730
  14. 150 ON KEY(4) GOSUB 1740:ON KEY(5) GOSUB 1720:KEY ON
  15. 160 ' THE FOLLOWING STATEMENTS WILL BE MODIFIED WITH F1
  16. 500 'BEGIN
  17. 505 KEY OFF
  18. 510 CLS:COLOR 0,7: PRINT "         PROGRAM INFORMATION         ":COLOR 7,0
  19. 520 PRINT "This program provides a sorted menu"
  20. 530 PRINT "display of the BASIC programs on your"
  21. 540 PRINT "diskette and allows for menu selected"
  22. 550 PRINT "execution of the BASIC programs."
  23. 560 PRINT " "
  24. 570 PRINT "Function key F1 is used whenever BASIC"
  25. 580 PRINT "programs are added or deleted from the"
  26. 590 PRINT "diskette. While F1 is slow to"
  27. 600 PRINT "execute the result will be a high"
  28. 610 PRINT "performance (for BASIC) menu program."
  29. 620 PRINT "F1 will create and kill file"
  30. 630 PRINT "BMENU.TMP and will modify itself."
  31. 640 PRINT "Be sure the default drive (set by DOS)"
  32. 650 PRINT "is the same as the drive containing"
  33. 660 PRINT "the menu program. See BMENU.DOC."
  34. 670 PRINT
  35. 680 COLOR 0,7:PRINT "Do not renum or change the name of this"
  36. 690 PRINT "program. This message will self        "
  37. 700 PRINT "destruct (forever) when you ENTER.     ":COLOR 7,0:PRINT
  38. 710 PRINT "          BOB STEPHENS SAN JOSE 12/1/82"
  39. 720 PRINT
  40. 730 INPUT "Press ENTER to continue...",A$
  41. 740 GOTO 1210
  42. 999 ' END
  43. 1000 ' END OF MODIFIED AREA
  44. 1005 CLS:IF ARRAY$(64)="" THEN WIDTH 40 ELSE WIDTH 80
  45. 1010 P=0:I=0:CLS:LOCATE 1,4:COLOR 14,0
  46. 1020 PRINT "BASIC programs on this diskette:"
  47. 1030 FOR DC=1 TO 66 STEP 13
  48. 1040  FOR DR=3 TO 23
  49. 1050   I=I+1
  50. 1060   IF ARRAY$(I)="" THEN 1130 ELSE LOCATE DR,DC
  51. 1070   IF MN=1 THEN COLOR 0,7 ELSE COLOR 1,14,4
  52. 1080   PRINT USING "###";I;
  53. 1090   IF MN=1 THEN COLOR 7,0 ELSE COLOR 14,1,4
  54. 1100   PRINT " ";ARRAY$(I)
  55. 1110  NEXT DR
  56. 1120 NEXT DC
  57. 1130 LOCATE 24,1,1,7,11:PRINT "Enter number of program desired: ";:B$=""
  58. 1140 A$=INKEY$:IF A$="" THEN 1140 ELSE IF ASC(A$)=13 THEN 1160
  59. 1150 IF (ASC(A$)<48) OR (ASC(A$)>57) THEN 1130 ELSE PRINT A$;:B$=B$+A$:GOTO 1140
  60. 1160 P=VAL(B$):IF P < 1 OR P >= I THEN 160
  61. 1170 WIDTH 80:CLS:PRINT "Press F10 to return to menu when finished"
  62. 1180 PRINT "or enter RUN";:PRINT CHR$(34);:PRINT "BMENU if F10 is changed."
  63. 1190 GOSUB 1650:ON ERROR GOTO 1750:RUN ARRAY$(P)
  64. 1200 ' MENU UPDATE AREA
  65. 1210 WIDTH 80:ON ERROR GOTO 1620
  66. 1220 KILL "BMENU.TMP"
  67. 1230 ON ERROR GOTO 0
  68. 1240 CLS:FILES "*.BAS":AR=0
  69. 1250 PRINT:PRINT:PRINT "Reading files":PRINT
  70. 1260 FOR I=1 TO 113
  71. 1270  ARRAY$(I)=""
  72. 1280 NEXT I
  73. 1290 FOR DR=1 TO 24
  74. 1300  FOR DC=0 TO 65 STEP 13
  75. 1310   IF CHR$(SCREEN(DR,DC+1)) = " " THEN 1390
  76. 1320   AR=AR+1:IF AR=113 THEN PRINT "To many files":END
  77. 1330   FOR L=1 TO 8
  78. 1340    ARRAY$(AR)=ARRAY$(AR)+CHR$(SCREEN(DR,DC+L))
  79. 1350   NEXT L
  80. 1360  NEXT DC
  81. 1370 NEXT DR
  82. 1380 ' SORT
  83. 1390 CKSW=1:PRINT "Sorting in BMENU.TMP";
  84. 1400 WHILE CKSW=1:CKSW=0
  85. 1410  FOR I=2 TO AR
  86. 1420   IF ARRAY$(I-1)>ARRAY$(I) THEN CKSW=1:SWAP ARRAY$(I-1),ARRAY$(I)
  87. 1430  NEXT I
  88. 1440 WEND
  89. 1450 ON ERROR GOTO 1580
  90. 1460 OPEN "BMENU.TMP" FOR OUTPUT AS #1
  91. 1470 ON ERROR GOTO 0
  92. 1480 PRINT #1,"500 'BEGIN"
  93. 1490 FOR I=1 TO AR
  94. 1500  PRINT #1,STR$(I+500) + " ARRAY$(" + STR$(I) + " )=" + CHR$(34) + ARRAY$(I) + CHR$(34)
  95. 1510 NEXT I
  96. 1520 PRINT #1,"999 'END"
  97. 1530 ON ERROR GOTO 1630
  98. 1540 CLOSE
  99. 1550 CHAIN MERGE "BMENU.TMP",1560,ALL,DELETE 500-999
  100. 1560 KILL "BMENU.TMP":SAVE "BMENU
  101. 1570 RUN"BMENU
  102. 1580 IF (ERR=70) AND (ERL=1460) THEN RESUME 1590 ELSE ON ERROR GOTO 0
  103. 1590 CLS:PRINT "The disk is write protected!"
  104. 1600 PRINT "Remove tab and press F10 or abort the program.":PRINT
  105. 1610 GOSUB 1650:END
  106. 1620 IF (ERR=53) AND (ERL=1220) THEN RESUME NEXT ELSE ON ERROR GOTO 0
  107. 1630 IF (ERR=5) AND (ERL=1550) THEN RESUME 1640 ELSE ON ERROR GOTO 0
  108. 1640 ON ERROR GOTO 0:CHAIN MERGE "BMENU.TMP",1560,ALL:GOTO 1560
  109. 1650 KEY OFF:KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34)
  110. 1660 KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY ON:RETURN
  111. 1670 CLS:PRINT "Exit to DOS and enter TYPE BMENU.DOC to"
  112. 1680 PRINT "display the information distributed"
  113. 1690 PRINT "with this program."
  114. 1700 ON ERROR GOTO 0:PRINT:PRINT "Press any key to continue...";
  115. 1710 A$=INKEY$:IF A$="" THEN 1710 ELSE RETURN 90
  116. 1720 CLS:PRINT:PRINT "DATE: " DATE$ "   TIME: " TIME$:GOTO 1700
  117. 1730 WIDTH 80:GOSUB 1650:END
  118. 1740 SYSTEM
  119. 1750 IF (ERR=53) AND (ERL=1190) THEN GOTO 1760 ELSE ON ERROR GOTO 0
  120. 1760 PRINT:PRINT "File " ARRAY$(P) ".BAS not found":RESUME 1700
  121.  (ERR=53) AND (